home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / keysrc.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  3KB  |  113 lines
  1. /* keysrc.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Table of constant values */
  9.  
  10. static integer c__8 = 8;
  11. static integer c__1 = 1;
  12.  
  13. /*<       subroutine keysrc(keytab,lentab,tstwrd,index) >*/
  14. /* Subroutine */ int keysrc_(keytab, lentab, tstwrd, index)
  15. doublereal *keytab;
  16. integer *lentab;
  17. doublereal *tstwrd;
  18. integer *index;
  19. {
  20.     /* Initialized data */
  21.  
  22.     static struct {
  23.     char e_1[8];
  24.     doublereal e_2;
  25.     } equiv_7 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  26.  
  27. #define ablnk (*(doublereal *)&equiv_7)
  28.  
  29.  
  30.     static doublereal akey;
  31.     extern /* Subroutine */ int move_();
  32.     extern integer xxor_();
  33.     static integer i;
  34.     static doublereal achar;
  35.     static integer lenwrd;
  36.     static doublereal tstchr;
  37.  
  38.     /* Parameter adjustments */
  39.     --keytab;
  40.  
  41.     /* Function Body */
  42. /*<       implicit double precision (a-h,o-z) >*/
  43. /*<       double precision keytab >*/
  44.  
  45. /*     this routine searches the keyword table 'keytab' for the possible 
  46. */
  47. /* entry 'tstwrd'.  abbreviations are considered as matches. */
  48.  
  49. /*<       dimension keytab(lentab) >*/
  50. /*<       integer xxor >*/
  51. /*<       data ablnk / 1h  / >*/
  52.  
  53.  
  54. /*<       index=0 >*/
  55.     *index = 0;
  56. /*<       lenwrd=0 >*/
  57.     lenwrd = 0;
  58. /*<       achar=ablnk >*/
  59.     achar = ablnk;
  60. /*<       do 10 i=1,8 >*/
  61.     for (i = 1; i <= 8; ++i) {
  62. /*<       call move(achar,8,tstwrd,i,1) >*/
  63.     move_(&achar, &c__8, tstwrd, &i, &c__1);
  64. /*<       if (achar.eq.ablnk) go to 20 >*/
  65.     if (achar == ablnk) {
  66.         goto L20;
  67.     }
  68. /*<       lenwrd=lenwrd+1 >*/
  69.     ++lenwrd;
  70. /*<    10 continue >*/
  71. /* L10: */
  72.     }
  73.  
  74. /*<    20 if (lenwrd.eq.0) go to 40 >*/
  75. L20:
  76.     if (lenwrd == 0) {
  77.     goto L40;
  78.     }
  79. /*<       tstchr=ablnk >*/
  80.     tstchr = ablnk;
  81. /*<       call move(tstchr,8,tstwrd,1,1) >*/
  82.     move_(&tstchr, &c__8, tstwrd, &c__1, &c__1);
  83. /*<    30 index=index+1 >*/
  84. L30:
  85.     ++(*index);
  86. /*<       if (index.gt.lentab) go to 40 >*/
  87.     if (*index > *lentab) {
  88.     goto L40;
  89.     }
  90. /*<       akey=ablnk >*/
  91.     akey = ablnk;
  92. /*<       call move(akey,1,keytab(index),1,lenwrd) >*/
  93.     move_(&akey, &c__1, &keytab[*index], &c__1, &lenwrd);
  94. /*<       if (xxor(akey,tstwrd).eq.0) go to 50 >*/
  95.     if (xxor_(&akey, tstwrd) == 0) {
  96.     goto L50;
  97.     }
  98. /*<       go to 30 >*/
  99.     goto L30;
  100.  
  101. /*<    40 index=-1 >*/
  102. L40:
  103.     *index = -1;
  104. /*<    50 return >*/
  105. L50:
  106.     return 0;
  107. /*<       end >*/
  108. } /* keysrc_ */
  109.  
  110. #undef ablnk
  111.  
  112.  
  113.